home *** CD-ROM | disk | FTP | other *** search
/ QRZ! Ham Radio 6 / QRZ Ham Radio Callsign Database - Volume 6.iso / pc / files / mac / proj_a1.hqx / Project Mac - A1 / MacMiniMUF.basic (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1987-07-20  |  8.8 KB  |  299 lines
  1. ' Sun Jul 19, 1987 (2230)
  2. ' MacMiniMUF
  3. '  Based on MINIMUF3.5 (Rose, QST, Dec.1982, pp 36-38.)
  4. ' Modified for Macintosh by J.S. Weaver, KA2OVS
  5. '  (5 Sayles St., Alfred, NY 14802)
  6. '  All commercial rights reserved.
  7.  
  8.    DEF FNSS(F)=-94.43+F*(1.6031+F*(-0.002189+5.20244e-315*F))
  9.    DEF FNFlux(S)=64.2+S*(0.7343+0.000829*S)
  10.    DIM MUF(24),Rect%(3)
  11.    GOSUB SetUp
  12.    ON MENU GOSUB DoMenu
  13.    MENU ON
  14.    ON <0x43,0x18df8010> GOSUB DoDialog
  15.    <0x43,0x18df8010> ON
  16.    
  17. Idle:                                                        ' Main idle loop
  18.    GOTO Idle
  19.  
  20. DoMenu:                                                    ' Menu handler
  21.    Nmenu=MENU(0)
  22.    IF Nmenu<>1 GOTO Nope
  23.    Nitem=MENU(1)
  24.    ON Nitem GOTO DoHelp,Nope,DoQuit
  25. Nope:                                                        ' Invalid choices land here
  26.    MENU
  27.    RETURN
  28. DoHelp:                                                    ' Help screen page 1
  29.    MENU
  30.    WINDOW 2
  31.    WINDOW OUTPUT 2
  32.    Page%=1
  33.    CALL Helper(Page%)
  34.    RETURN
  35. DoQuit:                                                     ' Exit program
  36.    MENU
  37.    END
  38.  
  39. DoDialog:                                                 ' Dialog handler
  40.    Act=<0x43,0x18df8010>(0)
  41.    ON Act GOTO DoButton,NewField,Nada,Nada,Nada,DoRet,DoTab
  42. Nada:                                                       ' Invalid choices land here
  43.    RETURN
  44. DoButton:
  45.    Nbutton=<0x43,0x18df8010>(1)
  46.    IF Nbutton=1 THEN                                ' "GO" button
  47.       GOTO DoCalcs
  48.    ELSEIF Nbutton=2 THEN                         ' "SSN" button
  49.       Bflag=2
  50.       <0x40,0x18df8010> 2,2
  51.       <0x40,0x18df8010> 3,1
  52.    ELSEIF Nbutton=3 THEN                         ' "Flux" button
  53.       Bflag=3
  54.       <0x40,0x18df8010> 2,1
  55.       <0x40,0x18df8010> 3,2
  56.    ELSEIF Nbutton=4 THEN                         ' "Quit" button
  57.       END
  58.    ELSEIF Nbutton=5 THEN                         ' "More" button
  59.       Page%=Page%+1
  60.       IF Page%>2 THEN Page%=1
  61.       CALL Helper(Page%)
  62.    ELSEIF Nbutton=6 THEN                         ' "OK" button
  63.       WINDOW 1
  64.       WINDOW OUTPUT 1
  65.       CALL <0x13,0x18df8010>(VARPTR(Rect%(0)))
  66.    END IF
  67.    RETURN
  68. NewField:                                                ' Moved to new edit field
  69.    Efield=<0x43,0x18df8010>(2)
  70.    GOSUB DoFlux                                      ' Update SSN or Flux
  71.    RETURN
  72. DoRet:
  73.    IF WINDOW(0)=1 THEN GOTO DoCalcs    ' Main screen <Return>
  74.    IF WINDOW(0)=2 THEN                           ' Help screen <Return>
  75.       WINDOW 1
  76.       WINDOW OUTPUT 1
  77.       CALL <0x13,0x18df8010>(VARPTR(Rect%(0)))
  78.    END IF
  79.    RETURN
  80. DoTab:                                                        ' Tab to next edit field
  81.    IF Efield<8 THEN Efield=Efield+1 :ELSE Efield=1
  82.    IF Bflag=2 AND Efield=4 THEN Efield=5
  83.    IF Bflag=3 AND Efield=3 THEN Efield=4
  84.    GOSUB DoFlux
  85.    RETURN
  86.  
  87.  
  88. DoCalcs:                                                   ' Calculate MUF for this date
  89.    GOSUB DoFlux                                      ' Update SSN or Flux
  90.    Month=VAL(EDIT$(1))                          ' Get current parameter values
  91.    Day=VAL(EDIT$(2))
  92.    SSN=VAL(EDIT$(3))
  93.    Lat1=VAL(EDIT$(5))
  94.    Long1=VAL(EDIT$(6))
  95.    Lat2=VAL(EDIT$(7))
  96.    Long2=VAL(EDIT$(8))
  97. DoMUF:
  98.    CALL <0x2f,0x18df8010>(VARPTR(Rect%(0)))    ' Set up graphics area
  99.    CALL <0x1e,0x18df8010> (250,10):  CALL <0x1e,0x02> (250,280)
  100.    CALL <0x20,0x18df8010> (490,280):  CALL <0x20,0x03> (490,10)
  101.    FOR F=0 TO 30 STEP 10
  102.       Y=280-8*F
  103.       CALL <0x22,0x18df8010> (230,Y+5):  PRINT USING "##"; F;
  104.       CALL <0x1f,0x18df8010> (250,Y):  CALL <0x1f,0x03> (255,Y)
  105.       CALL <0x21,0x18df8010> (490,Y):  CALL <0x21,0x03> (485,Y)
  106.       NEXT F
  107.    CALL <0x19,0x18df8010> (215,70):  PRINT "MUF";
  108.    CALL <0x1a,0x18df8010> (210,85):  PRINT "(MHz)"
  109.    FOR H=0 TO 24 STEP 6
  110.       X=250+10*H
  111.       CALL <0x22,0x18df8010> (X,280):   CALL <0x22,0x03> (X,275)
  112.       CALL <0x24,0x18df8010> (X-9,297):   PRINT USING "##"; H;
  113.       NEXT H
  114.    CALL <0x1a,0x18df8010> (395,300):  PRINT "UT";
  115.    Mflag=0                                                ' Signals start of line segment
  116.    FOR Hour=0 TO 24
  117.       CALL MUFFER (Lat1,Long1,Lat2,Long2,Month,Day,Hour,SSN,MUF)
  118.       MUF(Hour)=MUF
  119.       IF MUF<34 THEN                                ' Plot the MUF value
  120.          IF Mflag=0 THEN
  121.             CALL <0x1c,0x18df8010> (250+10*Hour,280-8*MUF)
  122.             Mflag=1
  123.          ELSE
  124.             CALL <0x1c,0x18df8010> (250+10*Hour,280-8*MUF)
  125.          END IF
  126.       ELSE
  127.          Mflag=0
  128.       END IF
  129.       NEXT Hour
  130.    CALL <0x43,0x18df8010> (10,155)                        ' Print table of MUF values
  131.    PRINT "Hour   MUF    Hour   MUF";
  132.    FOR H=0 TO 11
  133.       CALL <0x15,0x18df8010> (10,170+12*H)
  134.       PRINT USING " ##  ###.#      ## ###.#"; H,MUF(H),H+12,MUF(H+12);
  135.       NEXT H
  136.    RETURN
  137.  
  138. SetUp:                                                    ' Init the program
  139.    <0x18e00b1d,0x18df8010>(4)
  140.    <0x18e00b3b,0x18df8010>(9)
  141.    WINDOW 2,,(186,22)-(509,336),3        ' Help window
  142.    <0x40,0x18df8010> 5,1,"More",(100,290)-(150,310),1
  143.    <0x40,0x18df8010> 6,1,"OK",(200,290)-(250,310),1
  144.    WINDOW 1,,(1,21)-(511,339),3             ' Main window
  145.    WINDOW OUTPUT 1
  146.    MENU 1,0,1,"Help"                                  ' Setup menu
  147.    MENU 1,1,1,"Help"
  148.    MENU 1,2,0,"-"
  149.    MENU 1,3,1,"Quit"
  150.    D$=DATE$                                             ' Setup edit fields
  151.    CALL <0x1a,0x18df8010> (10,23): PRINT "Date:";
  152.    EDIT FIELD 1,MID$(D$,1,2),(60,10)-(80,25),1
  153.    CALL <0x16,0x18df8010> (93,23): PRINT "/";
  154.    EDIT FIELD 2,MID$(D$,4,2),(110,10)-(130,25),1
  155.    CALL <0x19,0x18df8010> (10,48): PRINT "SS#:";
  156.    <0x40,0x18df8010> 2,2,"",(55,35)-(70,50),3
  157.    Bflag=2
  158.    EDIT FIELD 3,"100",(80,35)-(110,50),1
  159.    CALL <0x1a,0x18df8010> (10,73): PRINT "Flux:";
  160.    <0x40,0x18df8010> 3,1,"",(55,60)-(70,75),3
  161.    EDIT FIELD 4,"",(80,60)-(110,75),1
  162.    CALL <0x19,0x18df8010> (60,95):  PRINT "Lat";
  163.    CALL <0x19,0x18df8010> (100,95): PRINT "Long";
  164.    CALL <0x1a,0x18df8010> (10,112): PRINT "Xmtr:";
  165.    EDIT FIELD 5, "42.3",(50,100)-(90,115),1
  166.    EDIT FIELD 6, "77.8",(95,100)-(135,115),1
  167.    CALL <0x1a,0x18df8010> (10,132): PRINT "Rcvr:";
  168.    EDIT FIELD 7, "43.5",(50,120)-(90,135),1
  169.    EDIT FIELD 8, "72.8",(95,120)-(135,135),1
  170.    <0x40,0x18df8010> 1,1,"Go",(150,10)-(180,30),1
  171.    <0x40,0x18df8010> 4,1,"Quit",(150,40)-(180,60),1
  172.    Efield=1
  173.    Rect%(0)=1:  Rect%(1)=200:  Rect%(2)=300:  Rect%(3)=495
  174. DoFlux:                                                    ' Updates SSN and Flux values
  175.    IF Bflag=2 THEN
  176.       S=VAL(EDIT$(3))
  177.       F=FNFlux(S)
  178.       EDIT FIELD 4,STR$(CINT(F)),(80,60)-(110,75),1
  179.    ELSEIF Bflag=3 THEN
  180.       F=VAL(EDIT$(4))
  181.       S=FNSS(F)
  182.       EDIT FIELD 3,STR$(CINT(S)),(80,35)-(110,50),1
  183.    END IF
  184.    X=FRE("")
  185.    EDIT FIELD Efield
  186.    RETURN
  187.    END
  188.    
  189. SUB MUFFER (Lata,Longa,Latb,Longb,Month,Day,Hour,SSN,MUF) STATIC
  190. ' A literal translation of the MINIMUF 3.5 code.
  191.    One=0.99999
  192.    Pi=4*ATN(1):  HalfPi=Pi/2:  TwoPi=2*Pi:  Rads=Pi/180
  193.    Lat1=Rads*Lata:  SLat1=SIN(Lat1):  CLat1=COS(Lat1)
  194.    Lat2=Rads*Latb:  SLat2=SIN(Lat2):  CLat2=COS(Lat2)
  195.    Long2=Rads*Longb:  DLong12=Rads*(Longa-Longb)
  196.    CR12=SLat1*SLat2+CLat1*CLat2*COS(DLong12)
  197.    IF ABS(CR12)>One THEN CR12=One*SGN(CR12)
  198.    SR12=SQR(1-CR12*CR12)
  199.    R12=HalfPi-ATN(CR12/SR12)
  200.    K6=1.59*R12
  201.    IF K6<=1 THEN
  202.       K6=1
  203.       K5=1
  204.       ELSE
  205.       K5=0.5
  206.       END IF
  207.    M9=2.5*R12*K5
  208.    IF M9<HalfPi THEN M9=SIN(M9) :ELSE M9=1
  209.    M9=(1+2.5*M9*SQR(M9))*(1+SSN/250)
  210.    M9=M9*(1+0.1*(1-SGN(Lat1)*SGN(Lat2)))
  211.    ElongSun=0.0172*(10+(Month-1)*30.4+Day)
  212.    DecSun=0.409*COS(ElongSun)
  213.    HA0Sun=12+0.13*(SIN(ElongSun)+1.2*SIN(2*ElongSun))
  214.    MUF=100
  215.    A=(SLat1-SLat2*CR12)/(CLat2*SR12)
  216.    FOR K1=1/(2*K6) TO 1-1/(2*K6) STEP 0.9999-1/K6
  217.       B=R12*K1
  218.       C=SLat2*COS(B)+CLat2*SIN(B)*A
  219.       Lat0=ATN(C/SQR(1-C*C))
  220.       D=(COS(B)-C*SLat2)/(CLat2*SQR(1-C*C))
  221.       IF ABS(D>One) THEN D=One*SGN(D)
  222.       Long0=Long2+SGN(SIN(DLong12))*(HalfPi-ATN(D/SQR(1-D*D)))
  223.       IF Long0<0 THEN Long0=Long0+TwoPi
  224.       IF Long0>=TwoPi THEN Long0=Long0-TwoPi
  225.       K8=3.82*Long0+HA0Sun
  226.       IF K8>24 THEN K8=K8-24
  227.       C0=COS(Lat0+DecSun)
  228.       IF C0<=-0.26 THEN  K9=0:  G0=0:  GOTO L1770
  229.       K9=(-0.26+SIN(DecSun)*SIN(Lat0))/(COS(DecSun)*COS(Lat0)+0.001)
  230.       K9=12-ATN(K9/SQR(ABS(1-K9*K9)))*7.63944
  231.       T=K8-K9/2
  232.       IF T<0 THEN T=T+24
  233.       T4=K8+K9/2
  234.       IF T4>24 THEN T4=T4-24
  235.       C0=ABS(C0)
  236.       T9=9.7*C0^9.6
  237.       IF T9<0.1 THEN T9=0.1
  238.       G8=Pi*T9/K9
  239.       IF T4<T THEN L1680
  240.       IF (Hour-T)*(T4-Hour)>0 THEN L1690 :ELSE L1820
  241. L1680:
  242.       IF (Hour-T4)*(T-Hour)>0 THEN L1820
  243. L1690:
  244.       IF T>Hour THEN T6=Hour+24 :ELSE T6=Hour
  245.       G9=Pi*(T6-T)/K9
  246.       G0=SIN(G9)+G8*(EXP((T-T6)/T9)-COS(G9))
  247.       G7=G8*(EXP(-K9/T9)+1)*EXP((K9-24)/2)
  248.       IF G0<G7 THEN G0=G7
  249.       GOTO L1770
  250. L1820:
  251.       T6=Hour+12*(1+SGN(T4-Hour))*SGN(ABS(T4-Hour))
  252.       G0=G8*(EXP(-K9/T9)+1)*EXP((T4-T6)/2)
  253. L1770:
  254.       G0=C0*G0/(1+G8*G8)
  255.       G2=M9*SQR(6+58*SQR(G0))
  256.       G2=G2*(1-0.1*EXP((K9-24)/3))
  257.       G2=G2
  258.       G2=G2*(1-0.1*(1+SGN(ABS(SIN(Lat0))-COS(Lat0))))
  259.       IF MUF>G2 THEN MUF=G2
  260.       NEXT K1
  261.    END SUB
  262.  
  263. SUB Helper (Page%) STATIC                    ' Prints help screens
  264.    CLS
  265.    ON Page% GOTO Page1,Page2
  266.    EXIT SUB
  267. Page1:
  268.    PRINT "                          MacMiniMUF"
  269.    PRINT "                                 by"
  270.    PRINT "                  J. Scott Weaver, KA2OVS"
  271.    PRINT "             5 Sayles St., Alfred, NY 14802"
  272.    PRINT "                             7/19/87
  273.    PRINT "            (All commercial rights reserved.)"
  274.    PRINT
  275.    PRINT "MacMiniMUF is a F-region propagation model useful"
  276.    PRINT "from 2 to 50 MHz and ranges from 250 to 6000"
  277.    PRINT "miles.  MacMiniMUF is based on MINIMUF 3.5.  (See:"
  278.    PRINT "Rose, R. B., K6GKU, 'MINIMUF:  A Simplified MUF-"
  279.    PRINT "Prediction Program for Microcomputers', QST, Dec."
  280.    PRINT "1982, pp. 36-38.)"
  281.    PRINT
  282.    PRINT "Note:  the Basic Compiler and Runtime Modules"
  283.    PRINT "are Copyright1986 by the Microsoft Corporation."
  284.    EXIT SUB
  285. Page2:
  286.    PRINT "                           MacMiniMUF"
  287.    PRINT
  288.    PRINT "Instructions:"
  289.    PRINT "Use mouse and keyboard to enter data into fields."
  290.    PRINT "TAB advances to next field.  Radio buttons select"
  291.    PRINT "solar input as Sunspot number or 2800MHz flux."
  292.    PRINT "GO button or Return key starts calculations.  QUIT"
  293.    PRINT "(button or menu choice) exits program."
  294.    PRINT
  295.    PRINT "Limits:    -90 <= Lat <= 90     -360 < Long < 360"
  296.    PRINT
  297.    PRINT "Warning:  No input error checking is done!"
  298.    END SUB
  299.